perm filename AFT.RUN[PAT,LMM] blob
sn#066032 filedate 1973-10-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00065 ENDMK
C⊗;
TELNET typescript file started at TUE 9 OCT 73 1247:24∨
#isi (settings loaded) is complete.#∨log masinter dendra
ISI-TENEX 1.31.38, ISI-TENEX EXEC 1.50.7
@LOG MASINTER 1
JOB 52 ON TTY57 9-OCT-73 12:52
MASINTER OVER ALLOCATION BY 48 PAGES.
YOU HAVE A MESSAGE
@LISP
BBN LISP-10 12-11-72 ...
GOOD AFTERNOON, LARRY.
←SYSIN(<SRIDHARAN>STRGEN.SAV\V\ASYS]
FILE NOT FOUND
<SRIDHARAN>STRGEN.SSYS
←USE S FOR##
$ S SS
<SRIDHARAN>STRGEN.SSYS-><SSRIDHARAN>STRGEN.SSYS
FILE NOT FOUND
<SSRIDHARAN>STRGEN.SSYS
←$##
UNDO
NOTHING SAVED.
←$ SS S
<SSRIDHARAN>STRGEN.SSYS-><SRIDHARAN>STRGEN.SSYS
FILE NOT FOUND
<SRIDHARAN>STRGEN.SSYS
←$ SS S
<SRIDHARAN>STRGEN.SSYS-><SRIDHARAN>STRGEN.SYS
(5-OCTOBER NEW START FUNCTION WILL ACCEPT ONE ARGUMENT: NIL OR A
FUNCTIONNAME E.G. RINGS)
←↑C
@SSAVE (PAGES FROM) 0 (TO) 777 (ON) S↑C
@DSK
98 TOTAL PAGES IN USE - 50 ALLOWED, 98 UNDELETED, 0 DELETED
SYSTEM TOTAL: 3173 PAGES LEFT, 32377 USED
@SSAVE (PAGES FROM) 0 (TO) 777 (ON) STRGEN.SAV [New file]
#signal.waiting.output #∨
#connection.to maxc is complete.#∨
PARC-MAXC-TENEX 1.29.23 EXEC 1.38.2
@log masinter \e\d 1
JOB 6 ON TTY61 9-OCT-73 12:50
YOU HAVE A MESSAGE
@lisp
↑C
@↑C
@dir <teiTELMAN>
<TEITELMAN>
CLISP. ;18,17,16
CLISPIFY.;34,33,32
.COM;7
COMP.SAV;9
COMPILE.;6,5
↑C
@↑C
@↑C
@dir <teiTELMAN>,
@@re
@@ch
@@
<TEITELMAN>
NEWORK.;9
PRETTY.;10
TELNET.TYPESCRIPT;100003;T
PRETTYSYS.;1
NEWORK.;8,7
DWIMSYS.;2
DWIM. ;9
NEWORK.;5
DWIMIFY.;30
CLISPIFY.;34
NEWORK.;4
LISPX.SAV;3
PRETTY.COM;12
. ;9
CLISPIFY.COM;7
DWIM.COM;10
FIX. ;19
CLISPIFY.;33
CLISP. ;18
DWIMIFY.;29
DWIM. ;8
RECORD.;1
LISPZ.SAV;1
WORK. ;94
FIX. ;18
COMP.SAV;9
NEWLISP.MISC;8
GLOBALVARS.;6
COMPILE.COM;6
. ;6
DWIMIFY.;28
CLISPIFY.;32
CLISP. ;17
DWIM. ;7
CLISP. ;16
COMPILE.;5
PRETTY.;7
ST . ;4
DWIM. ;6
PROPOSAL.RUNOFF;8
.TXT;15
∨<↑C
@get <teiTELMAN>lispx
@mer <tei↑Q? ↑X
@mer larry.SYS;
@ree
←CDC
TRAP AT LOCATION 343337
@dir↑C
@dir,
@@re
@@ch
@@
<MASINTER>
TELNET.TYPESCRIPT;100004;T
MESSAGE.TXT;1
S-STRGEN.CLISP;2
RECORD.;63
MESSAGE.COPY;1
SRI.MSG;1
A .STRGENSAV;1
STRGEN.ZARCHIVE;1
TESTDWIM.;2,1
RECORD.;62
LARRY.SYS;18
RECORD.;61
.COM;22
. ;60,59
LGO. ;3,2,1
LARRY.SYS;17
RECORD.;58
FOO.COM;1
. ;1
LARRY.SYS;16,15
JM . ;1
RECORD.;57
LARRY.SYS;14
RECORD.;56
.TEMMSG;2,1
Output waiting from connection 1∨∨@lispx↑C
@<teiTELMAN>lispx
#name.current.connection.to.be
Output waiting from connection 2∨maxc #∨
INTERLISP-10 07-23-73 ...
#n\n
Output waiting from connection maxc∨retrieve.connection.under.name 1 #∨@DSK
#nam
Output waiting from connection 1∨e.current.connection.to.be isi #∨ 607 TOTAL PAGES IN USE - 50 ALLOWED, 607 UNDELETED, 0 DELETED
SYSTEM TOTAL: 2773 PAGES LEFT, 32777 USED
@
#retrieve.connection.under.name isi #∨
#control
Output waiting from connection isi∨c #∨FTP
#retrieve.connection.under.name maxc #∨HI, LARRY.
(LISPXMACROS reset)
←
Output waiting from connection isi∨
#retrieve.connection.under.name isi #∨↑C
@CONT
NO PROGRAM
@FTP
USC-ISI FTP User process 1.18.0
*MAXC
?
? Type "HELP<RETURN>" for help.
*CONN MAXC
?
What?
*CONN PARC
Connection opened
Assuming 36-bit connections.
*< PARC-MAXC FTP Server 1.14.0 - at TUE 9-OCT-73 12:53-PDT
*LOG MASINTER 1
*D↑C
@R ?
@DIR STRGEN
<MASINTER>
STRGEN.SAV;1
@CONT
SEND STRGEN.SAV [Confirm]
to remote-file STRGEN.SAV
#ret
Output waiting from connection isi∨rieve.connection.under.name π
# #∨< Store of <MASINTER>STRGEN.SAV;1;P775200;A260736, Image type, started.
#retrieve.connection.under.name maxc #∨
]
NIL
←read##
CDC
(LCASEFLG reset)
T
←READMAIL]
MESSAGE.TXT;1
←LCASEFLG
OUTPUTONLY
←RAISEFLG
NIL
←SUBSYS(TECP]
=TECO
*;Y$
INPUT FILE: LISP.INIT
1275 CHARS
*SCDC$0TT$
(ADDTOVAR LISPXMACROS (CDC (LOWERCASE (QUOTE OUTPUTONLY](READMAIL)(PROGN
** (CLOSEALL) (RETFROM (QUOTE LOAD]
*S]$-\-I
$
*-K$
*-3LT$
(QUOTE OUTPUTONLY)) (RETURN (RAISE T))))))
*-7LT$
15586334719
*LT$
26911277056
*3L3T$
(RAISE-IN-LOWERCASE ((LOWERCASE . RAISE) (BEFORE NIL (AND (EQ FLG
(QUOTE OUTPUTONLY)) (RETURN (RAISE T))))))
(RAISE-IN-LISPXBLOCK ((LISPXBLOCK . RAISE) (BEFORE NIL (AND (EQ LCASEFLG
*-LT$
(DEFLIST(QUOTE(
*KT$
(RAISE-IN-LOWERCASE ((LOWERCASE . RAISE) (BEFORE NIL (AND (EQ FLG
*KT$
(QUOTE OUTPUTONLY)) (RETURN (RAISE T))))))
*KT$
(RAISE-IN-LISPXBLOCK ((LISPXBLOCK . RAISE) (BEFORE NIL (AND (EQ LCASEFLG
*KT$
(QUOTE OUTPUTONLY)) (RETURN (RAISE T))))))
*KT$
))(QUOTE READVICE))
*KT$
(READVISE RAISE-IN-LISPXBLOCK RAISE-IN-LOWERCASE]
*KT$
(READMAIL)(PROGN (CLOSEALL) (RETFROM (QUOTE LOAD]
*0JT$
READMAIL
*HT$
READMAIL
70
58
68
24352129024 ENTERF
0
58
23873978426
2424307771
23873978369
2424307772
23748149248 GUNBOX
9126805544
17221812225
26591887383
28454158357
17188257797
9126805544
17205035010
9126805524
-16760438272
28454158375
17188257795
9126805564
28454158348
17339252746
9126805653
28454158363
9126805527
28454158365
28454158348
-20392705987
28454158372
-20392705986
28454158372
-20392705985
28454158372
-20392705984
28454158372
-20392705983
23873978369
2424307778
28454158391
17188257797
9126805534
28454158371
17230200834
-34091302910
9126805527
28454158365
17330864151
9126805545
17196646406
-25073541120
-21315452918
9126805652
28454158369
17330864160
9126805544
23873978426
2424307779
24150802432
MESSAGE.TXT
IOFILE
OPNJFN
"NIN"
"SFPTR"
"ROUT"
"NOUT"
"SIZEF"
ERROR
CLOSEF
15586334719
26911277056
(SETQQ DWIMWAIT 5)(CHANGESLICE 100)(SETQQ FASTYPEFLG T)
(READMAIL)(PROGN (CLOSEALL) (RETFROM (QUOTE LOAD]
*;U
*T$
READMAIL
*ZJ-2LT$
(SETQQ DWIMWAIT 5)(CHANGESLICE 100)(SETQQ FASTYPEFLG T)
*I(SETQ LISPXMACROS (CONS (QUOTE (
*I(SETQ LISPXMACROS(CONS[QUOTE(↑C
@NO RAI
@con
$
*t$
(SETQQ DWIMWAIT 5)(CHANGESLICE 100)(SETQQ FASTYPEFLG T)
*-\-0t$
*-t$
26911277056
*i(SETQ LISPXMACROS(CONS[QUOTE(cdc (SETQ RAISEFLG T))\)\)
i(SETQ LISPXMACROS(CONS[QUOTE(cdc (SETQ RAISEFLG T]l\l
i(SETQ LISPXMACROS(CONS[QUOTE(cdc (SETQ RAISEFLG T]LISPXMACROS]
$
*-lt$
(SETQ LISPXMACROS(CONS[QUOTE(cdc (SETQ RAISEFLG T]LISPXMACROS]
*scdc$
*t$
(SETQ RAISEFLG T]LISPXMACROS]
*di(RAISE$
*;u$
OUTPUT FILE: LISP.INIT;7 [New version]
*;h$
131073
←g##
GR##
??
6. ←SUBSYS(TECP)
131073
5. ←RAISEFLG
NIL
4. ←LCASEFLG
OUTPUTONLY
3. ←READMAIL]
MESSAGE.TXT;1
2. ←CDC
(LCASEFLG reset)
T
1. ←(GREET)
HI, LARRY.
(LISPXMACROS reset)
T
←u##
UNDO 1
100 undosaves, continue saving ? yes
GREET undone.
←g##
GREET]
GC: 8
875, 10073 FREE WORDS
HELLO, LARRY.
T
←cdc
NIL
←CDC##
EDITV(LISPC\C
EDITV(LISPXMACROS]
edit
*P
((cdc &) (LISP &) (EXEC &) (SNDMSG &) (RETRIEVE &) (BEFORE &) (AFTER
&) (SY &) (DIR &) (OK &) (CONTIN &))
*1 PP
(cdc (RAISE (SETQ RAISEFLG T)))
*OK
LISPXMACROS
←CDC
u.b.a.
CDC
←LOAD(RECORD]
FILE CREATED 8-OCT-73 06:17:37
RECORDVARS
#retrieve.connection.under.name isi #∨ FORK WAIT AT 1535
LOAD AV. = 4.16, USED 0:01:04.7 IN 0:14:07
#retrieve.connection.under.name maxc #∨(GETLOCALDEC redefined)
(PRETTYTYPELST reset)
(PRETTYMACROS reset)
RECORD.;63
←EDIT##
ARGLIST(PRINTSTRUCTURE]
(X EXPRFLG FILE)
←CALLS(PRINTSTRUCTURE]
((PRINTSTRUCTURE ;PROGSTRUCBLOCK;) (X EXPRFLG FILE) NIL)
←CALLS(PROGSTRUCBLOCK]
((PRINTSTRUCTURE CALLS ;FNCHECK; ;RPLACA; ;NCONC1; ;DREVERSE; ;OPENP;
;OUTPUT; ;OUTFILE; ;ERROR; ;TERPRI; ;TREEPRINT; ;PRIN1; ;VARPRINT;
;CLOSEF; ;EXPRP; ;CCODEP; ;ATTACH; ;GETP; ;APPEND; ;NCONC; ERSETQ
NLSETQ PROG1 PROG2 RPAQ SETN ARG RPTQ ;DWIMIFY0; ;ARGTYPE; ;FIRSTFN;
;LASTFN; ;SUBRP; ;VARPRINT1A; ;PACK; ;NTHCHAR; ;GETD;) (PROGSTRUCBLOCK#0
FN FN FN FN FN) NIL)
←ARGLIST(TREEPRINT]
(X N)
←ARGLIST(VARPI\IRINT]
(DONELST TREELST)
←CALLS(TREEPRINT]
((TREEPRINT ;TREEPRINTBLOCK;) (X N) NIL)
←CALL##
CALLS(VARPRINT]
((VARPRINT ;TREEPRINTBLOCK;) (DONELST TREELST) NIL)
←(PRINTSTRUCTURE (FILEFNSLST 'RECORD]
TYPERECORD RECORD1 CLISPNOTRAN
RECORDECL FIELDSIN FIELDSIN
FIELDDEFS FIELDDEFS
MAKECROPFN1 MAKECROPFN1
MAKERPLAC2
/PUTDTST
/PUTDTST
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
RECORD RECORD1
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CLISPRECORD RECORDCLISPLOOKUP GETLOCALDEC
RECORDECL
RECRESPELL RECORDECL
GETLOCALDEC
FIELDDEFS
MAKERPLAC2
MYSUBST MYSUBST
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
RECCOMPOSE0 CREATE?
RECORDECL
RECLOOK RECORDCLISPLOOKUP
GETLOCALDEC
CLISPNOTRAN
RECCOMPOSE1 RECCOMPOSE2 RECCOMPOSE2
'CAR
'CDR
'CONS
RECCOMPOSE4 'CONS
RECCOMPOSE4
RECCOMPOSE4
EASYCOMPUTE
'CDR
'CONS
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
DWIMIFYREC
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
TYPERECORD [NAME&FIELDS; TEM; ]
called by:
RECORD1 [DECL; FNF,REDECLARELST,TEM,NAME,FIELD,TEM,CLASS,X,Y,X,Y;
DFNFLG,DWIMFLG,USERRECORDS,LISPXHIST,FILEPKGFLG,RECORDSPLIST,
RECORDTRANFLG,FIELD:1,'ACCESSFN,<IELD:4,FIELD:5>,CLISPARRAY]
called by: TYPERECORD,RECORD
CLISPNOTRAN [X; ; CLISPTRANFLG]
called by: RECORD1,RECCOMPOSE0
RECORDECL [DECL,DWIMDEFAULT; NAME,FIELDS; CLISPTRANFLG,CLISPARRAY]
called by: RECORD1,CLISPRECORD,RECRESPELL,RECCOMPOSE0
FIELDSIN [X; ; ]
called by: RECORDECL,FIELDSIN
FIELDDEFS [FORMAT,RCROPS; ; ]
called by: RECORD1,FIELDDEFS,CLISPRECORD
MAKECROPFN1 [RCROPS; ; ]
called by: FIELDDEFS,MAKECROPFN1
MAKERPLAC2 [FORM; TEM; CRLIST]
called by: RECORD1,CLISPRECORD
/PUTDTST [ATM,DEF; ; DFNFLG]
called by: RECORD1,TYPERECORD
RECORD [NAME&FIELDS; ; ]
called by:
CLISPRECORD [RECEXPR,FIELD,SETQFLG; TEM1,TEM2,SUBSTEXPR,SUBSTEXPR;
RECORDTRANFLG,EXPR,FAULTFN,RECORDREPLACEVALUEFLG]
called by:
RECORDCLISPLOOKUP [WORD,VAR1,VAR2,LISPFN,CLASS; TEM; EXPR,FAULTFN]
called by: CLISPRECORD,RECLOOK
GETLOCALDEC [EXPR,FN; TEM; FAULTFN]
called by: RECORDCLISPLOOKUP,CLISPRECORD,RECLOOK
RECRESPELL [FIELD,DECLST,TAIL; X; RECORDSPLIST]
called by: CLISPRECORD
MYSUBST [SEXPR; A,D; SUBSTEXPR]
called by: CLISPRECORD,MYSUBST
RECCOMPOSE0 [COMPOSESTATEMENT; TEMVAR,DEF,TYPERECORDFLG,FIELDS,DECL,
ALIST,TEM,USING,CREATE,DEFAULT,COPYING,TEM1,DEFAULTS,VARS,X,TEM;
CLISPCHANGE,VARS,FAULTFN]
called by:
CREATE? [X; ; ]
called by: RECCOMPOSE0
RECLOOK [RECNAME,TAIL; TEM,X; EXPR,FAULTFN,CLISPTRANFLG,X:2,
USERRECORDS,CLISPTRANLG]
called by: RECCOMPOSE0
RECCOMPOSE1 [FIELDS,USEDEF,COPYDEF; K; ]
called by: RECCOMPOSE0
RECCOMPOSE2 [FIELD,USEDEF,COPYDEF; TEM1,TEM2; ALIST,DEFAULTS,DEFAULT]
called by: RECCOMPOSE1,RECCOMPOSE2
'CAR [X; TEM; CRLIST]
called by: RECCOMPOSE2
'CDR [X; TEM; CRLIST]
called by: RECCOMPOSE2,RECCOMPOSE0
'CONS [CARPART,CDRPART; ; ]
called by: RECCOMPOSE2,RECCOMPOSE4,RECCOMPOSE0
RECCOMPOSE4 [FIELD; ; ]
called by: RECCOMPOSE2,RECCOMPOSE4,RECCOMPOSE1
EASYCOMPUTE [X; ; ]
called by: RECCOMPOSE0
DWIMIFYREC [TAIL,NEWVARS; VARS; VARS,COMPOSESTATEMENT,FAULTFN]
called by:
(TYPERECORD RECORD RECORD1 CLISPRECORD RECORDECL RECCOMPOSE0 'CAR
'CDR 'CONS RECCOMPOSE1 RECCOMPOSE2 RECCOMPOSE4 MAKECROPFN1 FIELDSIN
/PUTDTST FIELDDEFS MYSUBST MAKERPLAC2 RECORDCLISPLOOKUP RECRESPELL
CLISPNOTRAN CREATE? GETLOCALDEC RECLOOK DWIMIFYREC EASYCOMPUTE)
←EDITF(RECORD1]
edit
DW
IELD {in RECORD1} -> FIELD ? Yes
*OK
RECORD1
←DWIMIFY(RECOR\R\O
DWIMIFY(RECLOOK]
RECLOOK
←WHOO\OCALLS(CREATE?]
u.d.f.
WHOCALLS
←CDR(WHOCALLS]
NIL
←CDR(CPLISTS]
(FILEDEF (UTILITY.COM CPLISTS CPLISTSM))
←EDITF(RECCOMPOSE0]
edit
*F CREATE?
*0 P
(FUNCTION CREATE?)
*0 P
(SOME COMPOSESTATEMENT (FUNCTION CREATE?))
*0 P
(SETQ CREATE (SOME COMPOSESTATEMENT &))
*0##
0 P
((SETQ CREATE &) (SETQ FIELDS &))
*-1 F CREATE?
CREATE? ?
*BK P
(SETQ CREATE (SOME COMPOSESTATEMENT &))
*-1 -1 P
(FUNCTION CREATE?)
*(I 2 (COPY (GETD (QUOTE CREATE?]
*P
(FUNCTION (LAMBDA & &))
*-1 PP
[LAMBDA (X)
(OR (EQ X (QUOTE create))
(EQ X (QUOTE CREATE]
*E EDITV(RECORDVARS]
edit
(LP (DELETE CREATE?]
2 OCCURRENCES.
*OK
RECORDVARS
*E EDITV]
=RECORDVARS
edit
*LP (DELETE DWIMIFYREC]
2 OCCURRENCES.
*OK
RECORDVARS
*↑ P
(LAMBDA (COMPOSESTATEMENT) **COMMENT** (PROG & & & LPX & & & &
& & & LP2 & FOO & & & & & &) COMPOSESTATEMENT)
*-1 2 P
2 ?
*BK 2 P
(TEMVAR DEF TYPERECORDFLG FIELDS DECL ALIST TEM USING CREATE DEFAULT
COPYING TEM1 DEFAULTS)
*(E (SOT ##
E (SORT (##]
(ALIST COPYING CREATE DECL DEF DEFAULT DEFAULTS FIELDS TEM TEM1 TEMVAR
TYPERECORDFLG USING)
*NX P
(SETQ CLISPCHANGE T)
*NX P
(* Constructs a composition of FIELD using things from L - First L must
be split up into things in field)
*BK UP SW 1 2
*2 P
(SETQ CLISPCHANGE T)
*A (* BECAUSE, NO MATTER WHAT WE ARE DOING, THE \ \E\H\T
A (* BECAUSE, NO MATTER WHAT WE ARE DOING, WE WILL DWIMIFY THE ENTIRE TH
**ING]
*2 P
(* BECAUSE, NO MATTER WHAT WE ARE DOING, WE WILL DWIMIFY THE ENTIRE
THING)
*: (* TELLS DWIMIFY THAT WE'VE PROCESSED THE WOLE\E\L\OHOLE THING, AND N
**OT
TO C\CGO ON DWIMIFYING WITHIN - KEEPS THE FIELS\SD←VALUES WHICH WE PUT I
**N TO GOING BACK TO SETQS]
*1 P
(* TELLS DWIMIFY THAT WE'VE PROCESSED THE WHOLE THING, AND NOT TO GO ON
DWIMIFYING WITHIN - KEEPS THE FIELD←VALUES WHICH WE PUT IN TO GOING BACK
TO SETQS)
*(-2 %%]
*DW
*PP*
(* Tells DWIMIFY that we've processed the whole
thing, and not to go on dwimifying within -
Keeps the field←values which we put in to going back
to setqs)
*NX P
LPX
*NX P
(COND (& &))
*PP
[COND
([SETQ CREATE (SOME COMPOSESTATEMENT
(FUNCTION (LAMBDA (X)
(OR (EQ X (QUOTE create))
(EQ X (QUOTE CREATE]
(SETQ FIELDS (RECORDECL (SETQ DECL (RECLOOK (CADR CREATE)
(CDR CREATE]
*2 P
((SETQ CREATE &) (SETQ FIELDS &))
*(:\:
(* ##
MARK
*↑ SHOW RECLOOK
(RECLOOK (CADR CREATE) (CDR CREATE))
*E EDITF(CLISPRECORD]
edit
*F RECLOOK
RECLOOK ?
*E ##
OK
CLISPRECORD
*P
(RECLOOK (CADR CREATE) (CDR CREATE))
*E
Output waiting from connection isi∨
*
#retrieve.connection.under.name isi #∨< Transfer completed.
261120. bytes transferred, run time = 102501. MS,
Elapsed time = 1118256. MS, Rate = 8406. Baud.
*DIS
#retrieve.connection.under.name maxc #∨
*P
(RECLOOK (CADR CREATE) (CDR CREATE))
*E
Output waiting from connection isi∨EDITV##
*A##
I A (COPY (GETD (QUOTE RECLOOK]
*P
... (RECLOOK & &) (LAMBDA & & &))
*-1 P
(LAMBDA (RECNAME TAIL) **COMMENT** (PROG & RETRY &))
*3 P
(* LOOKS FOR RECORD DECLARATION)
*0 P
(LAMBDA (RECNAME TAIL) **COMMENT** (PROG & RETRY &))
*XTR -1
*P
(PROG (TEM) RETRY (OR & &))
*R RECNAME ##
PP
(PROG (TEM)
RETRY
(OR
(COND
[(NLISTP RECNAME)
(OR
(RECORDCLISPLOOKUP RECNAME NIL NIL NIL (QUOTE RECORD))
(GETP RECNAME (QUOTE CLISPRECORD))
(COND
((SETQ TEM
(FIXSPELL
RECNAME 70
(NCONC
[MAPCONC
(GETLOCALDEC EXPR FAULTFN)
(FUNCTION (LAMBDA (X)
(AND (OR (EQ (CAR X)
(QUOTE TYPERECORD))
(EQ (CAR X)
(QUOTE RECORD))
(EQ (CAR X)
CLISPTRANFLG))
(NLISTP (CADR X))
(LIST (CADR X]
USERRECORDS)
NIL TAIL NIL T))
(SETQ RECNAME TEM)
(GO RETRY]
([OR (EQ (CAR RECNAME)
(QUOTE RECORD))
(EQ (CAR RECNAME)
(QUOTE TYPERECORD))
(AND (EQ (CAR RECNAME)
CLISPTRANLG)
(FMEMB (CADDR RECNAME)
(QUOTE (RECORD TYPERECORD]
#
Output waiting from connection maxc∨retrieve.connection.under.name isi #∨*QUI
@QUI
NOT LEGAL IN TOP-LEVEL EXEC
@DSK
608 TOTAL PAGES IN USE - 50 ALLOWED, 608 UNDELETED, 0 DELETED
SYSTEM TOTAL: 2479 PAGES LEFT, 33071 USED
@DEL STR
#control c #∨
#
Output waiting from connection isi∨retrieve.connection.under.name maxc #∨
RECNAME))
(ERROR RECNAME "not a record" T)))
*
*
*E CAKKSππ
*∨*
# #∨
*P
(PROG (TEM) RETRY (OR & &))
*UNDO
XTR undone.
*P
(LAMBDA (RECNAME TAIL) **COMMENT** (PROG & RETRY &))
*UNDO
I undone.
*P
(RECLOOK (CADR CREATE) (CDR CREATE))
*N##
0 P
(SETQ DECL (RECLOOK & &))
*0 P
(RECORDECL (SETQ DECL &))
*0 P
(SETQ FIELDS (RECORDECL &))
*NX P
NX ?
*0 P
((SETQ CREATE &) (SETQ FIELDS &))
*NX P
NX ?
*0 P
(COND (& &))
*NX P
(COND (TEM &) (T & &))
*UP P
... (COND & &) (SETQ DECL &) **COMMENT** (SETQ TYPERECORDFLG &) (
SETQ TEM COMPOSESTATEMENT) (SETQ ALIST &) LP2 (COND & & &) FOO (COND
&) (SETQ DEF &) (COND &) (SETQ TEM1 &) (/RPLNODE COMPOSESTATEMENT
& &) (CLISPTRAN COMPOSESTATEMENT &))
*(LCL TT}\}Y:]
tty:
*EXAM RECLOOK RECORDCLISPLOOKUP
(*ANY* RECLOOK RECORDCLISPLOOKUP) ?
*F GETLOCAKDE##
F GETLOCALDEC
GETLOCALDEC ?
*P
((COND & &) (SETQ DECL &) **COMMENT** (SETQ TYPERECORDFLG &) (SETQ
TEM COMPOSESTATEMENT) (SETQ ALIST &) LP2 (COND & & &) FOO (COND &) (SETQ
DEF &) (COND &) (SETQ TEM1 &) (/RPLNODE COMPOSESTATEMENT & &) (CLISPTRAN
COMPOSESTATEMENT &))
*↑
*↑ OK
*P
... (COND & &) (SETQ DECL &) **COMMENT** (SETQ TYPERECORDFLG &) (
SETQ TEM COMPOSESTATEMENT) (SETQ ALIST &) LP2 (COND & & &) FOO (COND
&) (SETQ DEF &) (COND &) (SETQ TEM1 &) (/RPLNODE COMPOSESTATEMENT
& &) (CLISPTRAN COMPOSESTATEMENT &))
∨*BK P
LPX
*BK P
(* Tells DWIMIFY that we've processed the whole thing, and not to go on
dwimifying within - Keeps the field←values which we put in to going back
to setqs)
*
*∨*P
LPX
*NX P
(COND (& &))
*-1 P
((SETQ CREATE &) (SETQ FIELDS &))
*1 P
(SETQ CREATE (SOME COMPOSESTATEMENT &))
*NX P
(SETQ FIELDS (RECORDECL &))
*-1 P
(RECORDECL (SETQ DECL &))
*-1 P
(SETQ DECL (RECLOOK & &))
*-1 P
(RECLOOK (CADR CREATE) (CDR CREATE))
*(M##
E EDITF(RECLOOK]
edit
*P
(LAMBDA (RECNAME TAIL) **COMMENT** (PROG & RETRY &))
*-1 2 P
(TEM)
*N (DEC (GETLOCAKDEC]
*RC K L
GETLOCAKDEC->GETLOCALDEC
*NX P
RETRY
*NX P
(OR (COND & &) (ERROR RECNAME "not a record" T))
*2 P
(COND (& &) (& RECNAME))
*2 P
((NLISTP RECNAME) (OR & & &))
*-1 P
(OR (RECORDCLISPLOOKUP RECNAME NIL NIL NIL &) (GETP RECNAME &) (COND
&))
*2 P
(RECORDCLISPLOOKUP RECNAME NIL NIL NIL (QUOTE RECORD))
*E PP RECORDCLISPLOOKUP
(RECORDCLISPLOOKUP
[LAMBDA (WORD VAR1 VAR2 LISPFN CLASS) **COMMENT**
(PROG (TEM)
(RETURN (COND
((AND [OR CLASS (SETQ CLASS (GETP WORD
(QUOTE CLISPCLASS]
(SETQ TEM (GETLOCALDEC EXPR FAULTFN)))
**COMMENT**
(CLISPLOOKUP0 WORD VAR1 VAR2 TEM LISPFN CLASS))
(T (SELECTQ CLASS
(VALUE (CAR WORD))
((RECORD RECORDFIELD)
NIL)
(OR LISPFN (GETP WORD (QUOTE LISPFN))
WORD])
RECORDCLISPLOOKUP
*P
(RECORDCLISPLOOKUP RECNAME NIL NIL NIL (QUOTE RECORD))
*: (AND DEC (CLISPLOOKUP0 RECNAME NIL NIL DEC NIL (QUOTE RECORD]
*P
... (AND DEC &) (GETP RECNAME &) (COND &))
*2 P
(GETP RECNAME (QUOTE CLISPRECORD))
*NX P
(COND (& & &))
*PP
(COND
((SETQ TEM
(FIXSPELL RECNAME 70
(NCONC [MAPCONC
(GETLOCALDEC EXPR FAULTFN)
(FUNCTION (LAMBDA (X)
(AND (OR (EQ (CAR X)
(QUOTE TYPERECORD))
(EQ (CAR X)
(QUOTE ∨*P
(GETLOCALDEC EXPR FAULTFN)
*: DEC
*P
... DEC (FUNCTION &))
*0 P
(MAPCONC DEC (FUNCTION &))
*0 P
(NCONC (MAPCONC DEC &) USERRECORDS)
*0 P
(FIXSPELL RECNAME 70 (NCONC & USERRECORDS) NIL TAIL NIL T)
*NX P
NX ?
*0 P
(SETQ TEM (FIXSPELL RECNAME 70 & NIL TAIL NIL T))
*(← PROG]
*2 P
(TEM (DEC &))
*-1 P
(DEC (GETLOCALDEC))
*-1 N EXPR FAULTN\NFN
*
P
(GETLOCALDEC EXPR FAULTFN)
*0 P
(DEC (GETLOCALDEC EXPR FAULTFN))
*0 P
(TEM (DEC &))
*00 PP
(PROG (TEM (DEC (GETLOCALDEC EXPR FAULTFN)))
RETRY
(OR
(COND
[(NLISTP RECNAME)
(OR
(AND DEC (CLISPLOOKUP0 RECNAME NIL NIL DEC NIL
(QUOTE RECORD)))
(GETP RECNAME (QUOTE CLISPRECORD))
(COND
((SETQ TEM
(FIXSPELL
RECNAME 70
(NCONC
[MAPCONC
DEC
(FUNCTION (LAMBDA (X)
(AND (OR (EQ (CAR X)
(QUOTE TYPERECORD))
(EQ (CAR X)
(QUOTE RECORD))
(EQ (CAR X)
CLISPTRANFLG))
(NLISTP (CADR X))
(LIST (CADR X]
USERRECORDS)
NIL TAIL NIL T))
(SETQ RECNAME TEM)
(GO RETRY]
([OR (EQ (CAR RECNAME)
(QUOTE RECORD))
(EQ (CAR RECNAME)
(QUOTE TYPERECORD))
(AND (EQ (CAR RECNAME)
CLISPTRANLG)
(FMEMB (CADDR RECNAME)
(QUOTE (RECORD TYPERECORD]
RECNAME))
(ERROR RECNAME "not a record" T)))
*-2 P
RETRY
*NX P
(OR (COND & &) (ERROR RECNAME "not a record" T))
*2 -1 P
((OR & & &) RECNAME)
*(2 (RECORDECL
(2 (RECORDECL RECNAME]
*P
((OR & & &) (RECORDECL RECNAME))
*UNDO
(2 --) undone.
*1 PP
[OR (EQ (CAR RECNAME)
(QUOTE RECORD))
(EQ (CAR RECNAME)
(QUOTE TYPERECORD))
(AND (EQ (CAR RECNAME)
CLISPTRANLG)
(FMEMB (CADDR RECNAME)
(QUOTE (RECORD TYPERECORD]
*E PP RECORDECL
(RECORDECL
[LAMBDA (DECL DWIMDEFAULT)
(PROG NIL
(OR (LISTP DECL)
(RETURN))
(AND (EQ (CAR DECL)
CLISPTRANFLG)
(RETURN (CADR DECL)))
(RETURN
(SELECTQ
(CAR DECL)
[(RECORD TYPERECORD)
(OR (GETHASH DECL CLISPARRAY)
(PROG (NAME FIELDS)
(AND (OR (COND
((OR (EQ (CAR DECL)
(QUOTE TYPERECORD))
(NLISTP (CADR DECL)))
(SETQ NAME (CADR DECL))
(SETQ FIELDS (CADDR DECL))
(CDDDR DECL))
(T (SETQ NAME NIL)
(SETQ FIELDS (CADR DECL))
(CDDR DECL)))
(LISTP NAME)
(NLISTP FIELDS))
(ERROR "bad record declaration" DECL))
[CLISPTRAN DECL
(SETQ NAME
(LIST (FIELDSIN FIELDS)
NAME
(COND
((EQ (CAR DECL)
(QUOTE TYPERECORD))
(CONS NIL FIELDS))
(T FIELDS]
(RETURN NAME]
NIL])
RECORDECL
*P
(OR (EQ & &) (EQ & &) (AND & &))
*2 P
(EQ (CAR RECNAME) (QUOTE RECORD))
*NX P
(EQ (CAR RECNAME) (QUOTE TYPERECORD))
*0 P
(OR (EQ & &) (EQ & &) (AND & &))
*: (RECORDECL RECNAME]
*0 P
(COND (& &) (& RECNAME))
*-1 P
((RECORDECL RECNAME) RECNAME)
*0 P
(COND (& &) (& RECNAME))
*0 P
(OR (COND & &) (ERROR RECNAME "not a record" T))
*2 P
(COND (& &) (& RECNAME))
*2 P
((NLISTP RECNAME) (OR & & &))
*?##
-1 P
(OR (AND DEC &) (GETP RECNAME &) (COND &))
*0 P
((NLISTP RECNAME) (OR & & &))
*0 P
(COND (& &) (& RECNAME))
*S##
]
*0 P
(OR (COND & &) (ERROR RECNAME "not a record" T))
*OK
RECLOOK
*P
(RECLOOK (CADR CREATE) (CDR CREATE))
*0 P
(SETQ DECL (RECLOOK & &))
*0 P
(RECORDECL (SETQ DECL &))
*0 P
(SETQ FIELDS (RECORDECL &))
*0 P
((SETQ CREATE &) (SETQ FIELDS &))
*0 P
(COND (& &))
*NX PP
[COND
(TEM (OR CREATE (ERROR "no CREATE in" COMPOSESTATEMENT T)))
(T (PROG [(VARS (NCONC [AND CREATE (APPEND (CAR FIELDS)
(LIST (CADR CREATE]
(APPEND (QUOTE (CREATE
create
USING
using
COPYING
copying DEFAULT
default))
VARS]
(DWIMIFY1B (CDR COMPOSESTATEMENT)
COMPOSESTATEMENT
(CDR COMPOSESTATEMENT)
T NIL FAULTFN))
(COND
((NOT CREATE)
(SETQ TEM T)
(GO L∨*E EDITF(RECORDECL]
edit
*F CLISPTRANFLG
*0 P
(EQ (CAR DECL) CLISPTRANFLG)
*0 P
(AND (EQ & CLISPTRANFLG) (RETURN &))
*(-2\24\43 (
(-3 (OR (EQ (CADDR DECL)(QUOTE RECORD))(EQ (CADDDR\R\D
(-3 (OR (EQ (CADDR DECL)(QUOTE RECORD))(EQ (CADDR DECL)(QUOTE TYPERECORD
**]
*P
(AND (EQ & CLISPTRANFLG) (OR & &) (RETURN &))
*OK
GC: 8
3239, 10393 FREE WORDS
RECORDECL
*P
(LAMBDA (RECNAME TAIL) **COMMENT** (PROG & RETRY &))
*PP##
OK
RECLOOK
*P
(COND (TEM &) (T & &))
*BK P
(COND (& &))
*BK P
LPX
*NX P
(COND (& &))
*-1 P
((SETQ CREATE &) (SETQ FIELDS &))
*(-2 )
(-2) ?
*(-2 *\*(*
(-2 (* LOOK FOR A CREATE]
*0 P
(COND (& & &))
*NX P
(COND (TEM &) (T & &))
*2 P
(TEM (OR CREATE &))
*(-2 (* ALREADY DWIMIFIED, AND STILL NO CREATE]
*0##
P
(TEM **COMMENT** (OR CREATE &))
*NX P
(T (PROG & &) (COND &))
*(-2 (* DWIMIFY, WHETHER OR NI\IOT D\DWE'VE FUN\N\UOUND A CREATE]
*3 P
(PROG (&) (DWIMIFY1B & COMPOSESTATEMENT & T NIL FAULTFN))
*2 P
((VARS &))
*A (* RESET VARS TO INCLUDE ALL OF THE WORDS\S\D\R\O\WRECORDWORDS
A (* RESET VARS TO INCLUDE ALL OF THE RECORDWORDS AS WELL AS THE FIELD N
**AMES AND THE RECORD NAME]
*P
... (&) **COMMENT** (DWIMIFY1B & COMPOSESTATEMENT & T NIL FAULTFN))
*0 P
(PROG (&) **COMMENT** (DWIMIFY1B & COMPOSESTATEMENT & T NIL FAULTFN)
)
*0 P
(T **COMMENT** (PROG & & &) (COND &))
*-1 PP
(COND
((NOT CREATE)
(SETQ TEM T)
(GO LPX)))
*(1 AND]
*P
(AND (& & &))
*BO 2
*P
(AND (NOT CREATE) (SETQ TEM T) (GO LPX))
*MOVE 2 TO : 3 3
*P
(AND (SETQ TEM &) (GO LPX))
*PP
(AND (SETQ TEM (NOT CREATE))
(GO LPX))
*0 P
(T **COMMENT** (PROG & & &) (AND & &))
*0 P
(COND (TEM & &) (T & & &))
*NX P
(SETQ DECL (CLISPNOTRAN DECL))
*A (* JUST IN CASE THERE WAS A CLISP% FLAG]
*E PP CLISPNOTRAN
(CLISPNOTRAN
[LAMBDA (X)
(COND
((AND (LISTP X)
(EQ (CAR X)
CLISPTRANFLG))
(CDDR X))
(T X])
CLISPNOTRAN
*NX P
(* JUST IN CASE THERE WAS A CLISP% FLAG)
*NX P
(* DECL IS THE ACTUAL DECLARATION (USED FOR DETERMINING TYPERECORD) AND
FIELDS IS THE HASHED DECLARATION - (FIELDLIST DEFAULTS FIELDS ...))
*NX P
(SETQ TYPERECORDFLG (AND & &))
*PP
(SETQ TYPERECORDFLG (AND (EQ (CAR DECL)
(QUOTE TYPERECORD))
(CADR DECL)))
*E SNDMSG
Type ? for help
Users: TEOI\I\O
TEITELMAN
Subject: YOU ARE READING MY MIND!!!
Message (? for help):
I LOOKED AT CLISPLOOKUP1 WHERE YOU CHECK FOR CLASS = RECORD &
NOT RATHER THAN (CADR (RECORDECL FORM] AS I
HAD PREVIOUS \
HAD PREVIOUSLY STATED. BUT YOU'RE RIGHT.\.
HAD PREVIOUSLY STATED. BUT YOU'RE RIGHT! AND I CAN USE THAT
PLACE FOR STORING THE DWIM'ED DEFAULTSR DECL)))
*NX PP
(SETQ TEM COMPOSESTATEMENT)
*NX PP
[SETQ ALIST (MAPCAR (CAR FIELDS)
(FUNCTION (LAMBDA (X)
(LIST X]
*NX PP
LP2
*NX PP
(COND
[(LISTP (CAR TEM))
(SELECTQ (CAAR TEM)
[(SETQ SAVESETQ)
(OR (CDDR (CAR TEM))
(/RPLACD (CDAR TEM)
(CONS]
[(SETQQ SAVESETQQ)
(/RPLNODE (CAR TEM)
(QUOTE SETQ)
(LIST (CADAR TEM)
(KWOTE (CADDR (CAR TEM]
(ERROR "form not fieldname←value" TEM T))
(COND
((SETQ TEM1 (FASSOC (CADAR TEM)
ALIST))
(AND (CDR TEM1)
(ERROR "field specified twice" COMPOSESTATEMENT T))
(FRPLACD TEM1 (CDDAR TEM)))
((FIXSPELL (CADAR TEM)
70
(CAR FIELDS)
NIL
(CDAR TEM)
NIL T)
(GO LP∨*
*↑C
@;HI.
@; DON'T THINK SO.. GOT A CLASS THIS AFT.
@; YEP.
@U DID, THAT WAS F\FDIFFERENT THAN I HAD ASKED, BUT
@; WHICH I WAS ABOUT TO ASK YOU TO CHANGE... BUT YOU
@; DID IT THE WAY I WAS ABOUT TO ASK YOU TO CHANGE IT TO.
@;;I DUNNA UNNASTAN
@;NATURALLY.
@; HOPE SO. IT'S OFTEN LIKE ONE OF THOSE TREMORS WHEN
@; DIDDLING SUCHA COMPLEX PIECE OF CODE.
@;GREAT.
@;ALL RIGHT. IF I DON'T COME IN TOMORROW, I'LL GIVE YOU A CALL.
@;BYE
@BR
@QUI
NOT LEGAL IN TOP-LEVEL EXEC
@CONT
*P
(COND (& & &) (& &) (T &))
*PP
(COND
[(LISTP (CAR TEM))
(SELECTQ (CAAR TEM)
[(SETQ SAVESETQ)
(OR (CDDR (CAR TEM))
(/RPLACD (CDAR TEM)
(CONS]
[(SETQQ SAVESETQQ)
(/RPLNODE (CAR TEM)
(QUOTE SETQ)
(LIST (CADAR TEM)
(KWOTE (CADDR (CAR TEM]
(ERROR "form not fieldname←value" TEM T))
(COND
((SETQ TEM1 (FASSOC (CADAR TEM)
ALIST))
(AND (CDR TEM1)
(ERROR "field specified twice" COMPOSESTATEMENT T))
(FRPLACD TEM1 (CDDAR TEM)))
((FIXSPELL (CADAR TEM)
∨*
*E CALLS(CLISPLOOKUP0]
((HELP ;GETP; RECORD ;EVAL; TYPERECORD RECORDECL ;NTH; SETQQ) (WORD
VAR1 VAR2 DECLST LISPFN CLASS) NIL)
*P
(COND (& & &) (& &) (T &))
*2 PP
[(LISTP (CAR TEM))
(SELECTQ (CAAR TEM)
[(SETQ SAVESETQ)
(OR (CDDR (CAR TEM))
(/RPLACD (CDAR TEM)
(CONS]
[(SETQQ SAVESETQQ)
(/RPLNODE (CAR TEM)
(QUOTE SETQ)
(LIST (CADAR TEM)
(KWOTE (CADDR (CAR TEM]
(ERROR "form not fieldname←value" TEM T))
(COND
((SETQ TEM1 (FASSOC (CADAR TEM)
ALIST))
(AND (CDR TEM1)
(ERROR "field specified twice" COMPOSESTATEMENT T))
(FRPLACD TEM1 (CDD∨*
*BK P
COND
*0 BK P
LP2
*NX P
(COND (& & &) (& &) (T &))
*2 1 ?
(LISTP (CAR TEM))
*0 BK BK ?
BK ?
*0##
P
COND
*0 BK P
LP2
*BK P
(SETQ ALIST (MAPCAR & &))
*BK P
(SETQ TEM COMPOSESTATEMENT)
*NX P
(SETQ ALIST (MAPCAR & &))
*?
(SETQ ALIST (MAPCAR (CAR FIELDS) (FUNCTION (LAMBDA (X) (LIST X)))))
*BK ##
E ##
BK UP P
... (SETQ TEM COMPOSESTATEMENT) (SETQ ALIST &) LP2 (COND & & &) FOO (
COND &) (SETQ DEF &) (COND &) (SETQ TEM1 &) (/RPLNODE COMPOSESTATEMENT
& &) (CLISPTRAN COMPOSESTATEMENT &))
*BI 1 -2
*E DEFINE(((MAKEALIST(LISTOFSETQS##
1 P
((SETQ TEM COMPOSESTATEMENT) (SETQ ALIST &) LP2 (COND & & &) FOO (COND
&) (SETQ DEF &) (COND &) (SETQ TEM1 &) (/RPLNODE COMPOSESTATEMENT
& &))
*
*UNDO
BI undone.
*1 P
(SETQ TEM COMPOSESTATEMENT)
*NX P
(SETQ ALIST (MAPCAR & &))
*?
(SETQ ALIST (MAPCAR (CAR FIELDS) (FUNCTION (LAMBDA (X) (LIST X)))))
*NX P
LP2
*NX P
(COND (& & &) (& &) (T &))
*2 P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*1 ?
(LISTP (CAR TEM))
*NX P
(SELECTQ (CAAR TEM) (& &) (& &) (ERROR "form not fieldname←value"
TEM T))
*NX ?
(COND ((SETQ TEM1 (FASSOC (CADAR TEM) ALIST)) (AND (CDR TEM1) (ERROR
"field specified twice" COMPOSESTATEMENT T)) (FRPLACD TEM1 (CDDAR
TEM))) ((FIXSPELL (CADAR TEM) 70 (CAR FIELDS) NIL (CDAR TEM) NIL T)
(GO LP2)) (T (ERROR "Bad field name" (CADAR TEM) T)))
*NX ?
NX ?
*0 P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*NX P
((SELECTQ & & & & & NIL) (SETQ TEM &))
*1 P
(SELECTQ (CAR TEM) (& T) (& &) (& &) (& &) NIL)
*3 1 P
(CREATE create)
*0 P
((CREATE create) T)
*0 P
(SELECTQ (CAR TEM) (& T) (& &) (& &) (& &) NIL)
*0 P
((SELECTQ & & & & & NIL) (SETQ TEM &))
*0 P
(COND (& & &) (& &) (T &))
*0 P##
NX P
FOO
*:
*1 P
(COND (& &))
*PP
(COND
((SETQ TEM (CDR TEM))
(GO LP2)))
*BK P
(COND (& & &) (& &) (T &))
*S FOO
*E DEFINE(((FIXSETQ
E DEFINE(((FIXSETQ(SE##
P
(COND (& & &) (& &) (T &))
*2 P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*NX P
((SELECTQ & & & & & NIL) (SETQ TEM &))
*BK P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*2 UP P##
P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*E##
E(CALLS(##]
((((LISTP (CAR TEM)) (SELECTQ (CAAR TEM) ((SETQ SAVESETQ) (OR (CDDR
(CAR TEM)) (/RPLACD (CDAR TEM) (CONS)))) ((SETQQ SAVESETQQ) (/RPLNODE
(CAR TEM) (QUOTE SETQ) (LIST (CADAR TEM) (KWOTE (CADDR (CAR TEM))))))
(ERROR "form not fieldname←value" TEM T)) (COND ((SETQ TEM1 (FASSOC
(CADAR TEM) ALIST)) (AND (CDR TEM1) (ERROR "field specified twice"
COMPOSESTATEMENT T)) (FRPLACD TEM1 (CDDAR TEM))) ((FIXSPELL (CADAR
∨*P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*2 P
(SELECTQ (CAAR TEM) (& &) (& &) (ERROR "form not fieldname←value"
TEM T))
*E (CALLS(#]
u.d.f.
#
E ?
*E (CALLS(##]
((CAAR /RPLACD CDAR /RPLNODE CADAR KWOTE ERROR) NIL (TEM))
*P##
NX P
(COND (& & &) (& &) (T &))
*E (CALLS(##]
((FASSOC CADAR ERROR FRPLACD CDDAR FIXSPELL CDAR) NIL (TEM1 TEM ALIST
COMPOSESTATEMENT FIELDS))
*0 P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*2 P
(SELECTQ (CAAR TEM) (& &) (& &) (ERROR "form not fieldname←value"
TEM T))
*0 P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*S FOO
(FOO reset)
*UNDO
S undone.
*E DEFINE(((RECORDFIELDSETQ(SETQTAIL ALIST)(* FINDS]
(RECORDFIELDSETQ)
E EDITF]
=RECORDFIELDSETQ
edit
*I N (COPY FOO]
*-1 P
(COND (& & &) (& &) (T &))
*2 ##
2 P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*1 P
(LISTP (CAR TEM))
*↑ P
(LAMBDA (SETQTAIL ALIST) **COMMENT** (COND & & &))
*R TEM SETQTAIL
*-1 2 P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*1 PP
(LISTP (CAR SETQTAIL))
*NX PP
(SELECTQ (CAAR SETQTAIL)
[(SETQ SAVESETQ)
(OR (CDDR (CAR SETQTAIL))
(/RPLACD (CDAR SETQTAIL)
(CONS]
[(SETQQ SAVESETQQ)
(/RPLNODE (CAR SETQTAIL)
(QUOTE SETQ)
(LIST (CADAR SETQTAIL)
(KWOTE (CADDR (CAR SETQTAIL]
(ERROR "form not fieldname←value" SETQTAIL T))
*F ERROR
*P
(ERROR "form not fieldname←value" SETQTAIL T)
*(2 "NO\O\N
(2 "MISSING FIELD SPECIFICATION IN"]
*2 P
"MISSING FIELD SPECIFICATION IN"
*DW
*P
... "MISSING FIELD SPECIFICATION IN" SETQTAIL T)
*LOWER
*P
... "missing field specification in" SETQTAIL T)
*1 REPACK
edit
*1 RAISE
*OK
"Missing field specification in"
*0 P
(ERROR "Missing field specification in" SETQTAIL T)
*0 P
(SELECTQ (CAAR SETQTAIL) (& &) (& &) (ERROR
"Missing field specification in" SETQTAIL T))
*N##
0 P
((LISTP &) (SELECTQ & & & &) (COND & & &))
*-1 2 P
((SETQ TEM1 &) (AND & &) (FRPLACD TEM1 &))
*1 P
(SETQ TEM1 (FASSOC & ALIST))
*?
(SETQ TEM1 (FASSOC (CADAR SETQTAIL) ALIST))
*NX P
(AND (CDR TEM1) (ERROR "field specified twice" COMPOSESTATEMENT T))
*-1 2 P
"field specified twice"
*REPACK
edit
*N % IN
*-1 LOWER
*!0 1 RAISE
*OK
"Field specified twice in"
*0 P
(ERROR "Field specified twice in" COMPOSESTATEMENT T)
*0 P
(AND (CDR TEM1) (ERROR "Field specified twice in" COMPOSESTATEMENT
T))
*N##
0 P
((SETQ TEM1 &) (AND & &) (FRPLACD TEM1 &))
*PP
((SETQ TEM1 (FASSOC (CADAR SETQTAIL)
ALIST))
(AND (CDR TEM1)
(ERROR "Field specified twice in" COMPOSESTATEMENT T))
(FRPLACD TEM1 (CDDAR SETQTAIL)))
*NX PP
((FIXSPELL (CADAR SETQTAIL)
70
(CAR FIELDS)
NIL
(CDAR SETQTAIL)
NIL T)
(GO LP2))
*↑ 2 P
(SETQTAIL ALIST)
*N FIELDS TOP]
P
(SETQTAIL ALIST FIELDS TOP)
*NX P
(* FINDS)
*N ##
P
(* FINDS)
*(2 FIXES UP "SETQ##
(2 FIXES UP A LIST OF "SETQ##
N##
(2 MAKES##
(2 INSETR\R\T
(2 INSERTS A "SET##
(2 INSERTS INTO ALIST THE "SETQ'S" NECCESARY TO↑W\↑W\O\T\ ##
(2 INSERTS INTO ALIST THE VALUES FROM THE "SETQ"'S IN SETQTAIL]
*(-2 %%]
*PP=\=*
(* Inserts into alist
the values from the "SET
**Q"
'S in setqtail)
*4 P
alist
*DW##
RAISE
*F "SETQ"
*P
... "SETQ" 'S in setqtail)
*(1)
*(1 SETQ'S]
*0 P
... ALIST the values from the SETQ'S in setqtail)
*-1 RAISE
*0 P
... ALIST the values from the SETQ'S in SETQTAIL)
*0 P
(* Inserts into ALIST the values from the SETQ'S in SETQTAIL)
*NX P
(COND (& & &) (& &) (T &))
*2 PP
[(LISTP (CAR SETQTAIL))
(SELECTQ (CAAR SETQTAIL)
[(SETQ SAVESETQ)
(OR (CDDR (CAR SETQTAIL))
(/RPLACD (CDAR SETQTAIL)
(CONS]
[(SETQQ SAVESETQQ)
(/RPLNODE (CAR SETQTAIL)
(QUOTE SETQ)
(LIST (CADAR SETQTAIL)
(KWOTE (CADDR (CAR SETQTAIL]
(ERROR "Missing field specification in" SETQTAIL T))
(COND
((SETQ TE